home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / f2c-9510.000 / f2c-9510 / f2c-951007-libs-1.1 / src / sysdep.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-10-08  |  11.9 KB  |  521 lines
  1. /****************************************************************
  2. Copyright 1990 - 1994 by AT&T Bell Laboratories and Bellcore.
  3.  
  4. Permission to use, copy, modify, and distribute this software
  5. and its documentation for any purpose and without fee is hereby
  6. granted, provided that the above copyright notice appear in all
  7. copies and that both that the copyright notice and this
  8. permission notice and warranty disclaimer appear in supporting
  9. documentation, and that the names of AT&T Bell Laboratories or
  10. Bellcore or any of their entities not be used in advertising or
  11. publicity pertaining to distribution of the software without
  12. specific, written prior permission.
  13.  
  14. AT&T and Bellcore disclaim all warranties with regard to this
  15. software, including all implied warranties of merchantability
  16. and fitness.  In no event shall AT&T or Bellcore be liable for
  17. any special, indirect or consequential damages or any damages
  18. whatsoever resulting from loss of use, data or profits, whether
  19. in an action of contract, negligence or other tortious action,
  20. arising out of or in connection with the use or performance of
  21. this software.
  22. ****************************************************************/
  23. #include "defs.h"
  24. #include "usignal.h"
  25.  
  26. char binread[] = "rb", textread[] = "r";
  27. char binwrite[] = "wb", textwrite[] = "w";
  28. char *c_functions    = "c_functions";
  29. char *coutput        = "c_output";
  30. char *initfname        = "raw_data";
  31. char *initbname        = "raw_data.b";
  32. char *blkdfname        = "block_data";
  33. char *p1_file        = "p1_file";
  34. char *p1_bakfile    = "p1_file.BAK";
  35. char *sortfname        = "init_file";
  36. char *proto_fname    = "proto_file";
  37.  
  38. char link_msg[]        = "-lf2c or -lf2c_i2\n\t\tand\n\t\t-lm\n" \
  39.                           "\t(see the manual page for more details, and link)\n\t"; 
  40.  
  41. char *outbuf = "", *outbtail;
  42.  
  43. #ifndef TMPDIR
  44. #ifdef MSDOS
  45. #define TMPDIR ""
  46. #else
  47. #define TMPDIR "/tmp"
  48. #endif
  49. #endif
  50.  
  51. char *tmpdir = TMPDIR;
  52. #ifndef MSDOS
  53. #ifndef KR_headers
  54. extern int getpid(void);
  55. #endif
  56. #endif
  57.  
  58.  void
  59. #ifdef KR_headers
  60. Un_link_all(cdelete)
  61.     int cdelete;
  62. #else
  63. Un_link_all(int cdelete)
  64. #endif
  65. {
  66. #ifndef KR_headers
  67.     extern int unlink(const char *);
  68. #endif
  69.     if (!debugflag) {
  70.         unlink(c_functions);
  71.         unlink(initfname);
  72.         unlink(p1_file);
  73.         unlink(sortfname);
  74.         unlink(blkdfname);
  75.         if (cdelete && coutput)
  76.             unlink(coutput);
  77.         }
  78.     }
  79.  
  80.  void
  81. set_tmp_names(Void)
  82. {
  83.     int k;
  84.     if (debugflag == 1)
  85.         return;
  86.     k = strlen(tmpdir) + 16;
  87.     c_functions = (char *)ckalloc(7*k);
  88.     initfname = c_functions + k;
  89.     initbname = initfname + k;
  90.     blkdfname = initbname + k;
  91.     p1_file = blkdfname + k;
  92.     p1_bakfile = p1_file + k;
  93.     sortfname = p1_bakfile + k;
  94.     {
  95. #ifdef MSDOS
  96.     char buf[64], *s, *t;
  97.     if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
  98.         t = "";
  99.     else {
  100.         /* substitute \ for / to avoid confusion with a
  101.          * switch indicator in the system("sort ...")
  102.          * call in formatdata.c
  103.          */
  104.         for(s = tmpdir, t = buf; *s; s++, t++)
  105.             if ((*t = *s) == '/')
  106.                 *t = '\\';
  107.         if (t[-1] != '\\')
  108.             *t++ = '\\';
  109.         *t = 0;
  110.         t = buf;
  111.         }
  112.     sprintf(c_functions, "%sf2c_func", t);
  113.     sprintf(initfname, "%sf2c_rd", t);
  114.     sprintf(blkdfname, "%sf2c_blkd", t);
  115.     sprintf(p1_file, "%sf2c_p1f", t);
  116.     sprintf(p1_bakfile, "%sf2c_p1fb", t);
  117.     sprintf(sortfname, "%sf2c_sort", t);
  118. #else
  119.     int pid = getpid();
  120.     sprintf(c_functions, "%s/f2c%d_func", tmpdir, pid);
  121.     sprintf(initfname, "%s/f2c%d_rd", tmpdir, pid);
  122.     sprintf(blkdfname, "%s/f2c%d_blkd", tmpdir, pid);
  123.     sprintf(p1_file, "%s/f2c%d_p1f", tmpdir, pid);
  124.     sprintf(p1_bakfile, "%s/f2c%d_p1fb", tmpdir, pid);
  125.     sprintf(sortfname, "%s/f2c%d_sort", tmpdir, pid);
  126. #endif
  127.     sprintf(initbname, "%s.b", initfname);
  128.     }
  129.     if (debugflag)
  130.         fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
  131.             initfname, blkdfname, p1_file, p1_bakfile, sortfname);
  132.     }
  133.  
  134.  char *
  135. #ifdef KR_headers
  136. c_name(s, ft)
  137.     char *s;
  138.     int ft;
  139. #else
  140. c_name(char *s, int ft)
  141. #endif
  142. {
  143.     char *b, *s0;
  144.     int c;
  145.  
  146.     b = s0 = s;
  147.     while(c = *s++)
  148.         if (c == '/')
  149.             b = s;
  150.     if (--s < s0 + 3 || s[-2] != '.'
  151.              || ((c = *--s) != 'f' && c != 'F')) {
  152.         infname = s0;
  153.         Fatal("file name must end in .f or .F");
  154.         }
  155.     strcpy(outbtail, b);
  156.     outbtail[s-b] = ft;
  157.     b = copys(outbuf);
  158.     return b;
  159.     }
  160.  
  161.  static void
  162. #ifdef KR_headers
  163. killed(sig)
  164.     int sig;
  165. #else
  166. killed(int sig)
  167. #endif
  168. {
  169.     sig = sig;    /* shut up warning */
  170.     signal(SIGINT, SIG_IGN);
  171. #ifdef SIGQUIT
  172.     signal(SIGQUIT, SIG_IGN);
  173. #endif
  174. #ifdef SIGHUP
  175.     signal(SIGHUP, SIG_IGN);
  176. #endif
  177.     signal(SIGTERM, SIG_IGN);
  178.     Un_link_all(1);
  179.     exit(126);
  180.     }
  181.  
  182.  static void
  183. #ifdef KR_headers
  184. sig1catch(sig)
  185.     int sig;
  186. #else
  187. sig1catch(int sig)
  188. #endif
  189. {
  190.     sig = sig;    /* shut up warning */
  191.     if (signal(sig, SIG_IGN) != SIG_IGN)
  192.         signal(sig, killed);
  193.     }
  194.  
  195.  static void
  196. #ifdef KR_headers
  197. flovflo(sig)
  198.     int sig;
  199. #else
  200. flovflo(int sig)
  201. #endif
  202. {
  203.     sig = sig;    /* shut up warning */
  204.     Fatal("floating exception during constant evaluation; cannot recover");
  205.     /* vax returns a reserved operand that generates
  206.        an illegal operand fault on next instruction,
  207.        which if ignored causes an infinite loop.
  208.     */
  209.     signal(SIGFPE, flovflo);
  210. }
  211.  
  212.  void
  213. #ifdef KR_headers
  214. sigcatch(sig)
  215.     int sig;
  216. #else
  217. sigcatch(int sig)
  218. #endif
  219. {
  220.     sig = sig;    /* shut up warning */
  221.     sig1catch(SIGINT);
  222. #ifdef SIGQUIT
  223.     sig1catch(SIGQUIT);
  224. #endif
  225. #ifdef SIGHUP
  226.     sig1catch(SIGHUP);
  227. #endif
  228.     sig1catch(SIGTERM);
  229.     signal(SIGFPE, flovflo);  /* catch overflows */
  230.     }
  231.  
  232.  
  233. dofork(Void)
  234. {
  235. #ifdef MSDOS
  236.     Fatal("Only one Fortran input file allowed under MS-DOS");
  237. #else
  238. #ifndef KR_headers
  239.     extern int fork(void), wait(int*);
  240. #endif
  241.     int pid, status, w;
  242.     extern int retcode;
  243.  
  244.     if (!(pid = fork()))
  245.         return 1;
  246.     if (pid == -1)
  247.         Fatal("bad fork");
  248.     while((w = wait(&status)) != pid)
  249.         if (w == -1)
  250.             Fatal("bad wait code");
  251.     retcode |= status >> 8;
  252. #endif
  253.     return 0;
  254.     }
  255.  
  256. /* Initialization of tables that change with the character set... */
  257.  
  258. char escapes[Table_size];
  259.  
  260. #ifdef non_ASCII
  261. char *str_fmt[Table_size];
  262. static char *str0fmt[127] = { /*}*/
  263. #else
  264. char *str_fmt[Table_size] = {
  265. #endif
  266.  "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
  267.    "\\b",   "\\t",   "\\n", "\\013",   "\\f",   "\\r", "\\016", "\\017",
  268.  "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
  269.  "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
  270.      " ",     "!",  "\\\"",     "#",     "$",     "%%",    "&",     "'",
  271.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  272.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  273.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  274.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  275.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  276.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  277.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  278.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  279.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  280.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  281.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  282.      };
  283.  
  284. #ifdef non_ASCII
  285. char *chr_fmt[Table_size];
  286. static char *chr0fmt[127] = {    /*}*/
  287. #else
  288. char *chr_fmt[Table_size] = {
  289. #endif
  290.    "\\0",   "\\1",   "\\2",   "\\3",   "\\4",   "\\5",   "\\6",   "\\7",
  291.    "\\b",   "\\t",   "\\n",  "\\13",   "\\f",   "\\r",  "\\16",  "\\17",
  292.   "\\20",  "\\21",  "\\22",  "\\23",  "\\24",  "\\25",  "\\26",  "\\27",
  293.   "\\30",  "\\31",  "\\32",  "\\33",  "\\34",  "\\35",  "\\36",  "\\37",
  294.      " ",     "!",    "\"",     "#",     "$",     "%%",    "&",   "\\'",
  295.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  296.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  297.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  298.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  299.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  300.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  301.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  302.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  303.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  304.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  305.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  306.      };
  307.  
  308.  void
  309. fmt_init(Void)
  310. {
  311.     static char *str1fmt[6] =
  312.         { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
  313.     register int i, j;
  314.     register char *s;
  315.  
  316.     /* str_fmt */
  317.  
  318. #ifdef non_ASCII
  319.     i = 0;
  320. #else
  321.     i = 127;
  322. #endif
  323.     for(; i < Table_size; i++)
  324.         str_fmt[i] = "\\%03o";
  325. #ifdef non_ASCII
  326.     for(i = 32; i < 127; i++) {
  327.         s = str0fmt[i];
  328.         str_fmt[*(unsigned char *)s] = s;
  329.         }
  330.     str_fmt['"'] = "\\\"";
  331. #else
  332.     if (Ansi == 1)
  333.         str_fmt[7] = chr_fmt[7] = "\\a";
  334. #endif
  335.  
  336.     /* chr_fmt */
  337.  
  338. #ifdef non_ASCII
  339.     for(i = 0; i < 32; i++)
  340.         chr_fmt[i] = chr0fmt[i];
  341. #else
  342.     i = 127;
  343. #endif
  344.     for(; i < Table_size; i++)
  345.         chr_fmt[i] = "\\%o";
  346. #ifdef non_ASCII
  347.     for(i = 32; i < 127; i++) {
  348.         s = chr0fmt[i];
  349.         j = *(unsigned char *)s;
  350.         if (j == '\\')
  351.             j = *(unsigned char *)(s+1);
  352.         chr_fmt[j] = s;
  353.         }
  354. #endif
  355.  
  356.     /* escapes (used in lex.c) */
  357.  
  358.     for(i = 0; i < Table_size; i++)
  359.         escapes[i] = i;
  360.     for(s = "btnfr0", i = 0; i < 6; i++)
  361.         escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
  362.     /* finish str_fmt and chr_fmt */
  363.  
  364.     if (Ansi)
  365.         str1fmt[5] = "\\v";
  366.     if ('\v' == 'v') { /* ancient C compiler */
  367.         str1fmt[5] = "v";
  368. #ifndef non_ASCII
  369.         escapes['v'] = 11;
  370. #endif
  371.         }
  372.     else
  373.         escapes['v'] = '\v';
  374.     for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
  375.         str_fmt[j] = chr_fmt[j] = str1fmt[i++];
  376.     /* '\v' = 11 for both EBCDIC and ASCII... */
  377.     chr_fmt[11] = Ansi ? "\\v" : "\\13";
  378.     }
  379.  
  380.  void
  381. outbuf_adjust(Void)
  382. {
  383.     int n, n1;
  384.     char *s;
  385.  
  386.     n = n1 = strlen(outbuf);
  387.     if (*outbuf && outbuf[n-1] != '/')
  388.         n1++;
  389.     s = Alloc(n+64);
  390.     outbtail = s + n1;
  391.     strcpy(s, outbuf);
  392.     if (n != n1)
  393.         strcpy(s+n, "/");
  394.     outbuf = s;
  395.     }
  396.  
  397.  
  398. /* Unless SYSTEM_SORT is defined, the following gives a simple
  399.  * in-core version of dsort().  On Fortran source with huge DATA
  400.  * statements, the in-core version may exhaust the available memory,
  401.  * in which case you might either recompile this source file with
  402.  * SYSTEM_SORT defined (if that's reasonable on your system), or
  403.  * replace the dsort below with a more elaborate version that
  404.  * does a merging sort with the help of auxiliary files.
  405.  */
  406.  
  407. #ifdef SYSTEM_SORT
  408.  
  409.  int
  410. #ifdef KR_headers
  411. dsort(from, to)
  412.     char *from;
  413.     char *to;
  414. #else
  415. dsort(char *from, char *to)
  416. #endif
  417. {
  418.     char buf[200];
  419.     sprintf(buf, "sort <%s >%s", from, to);
  420.     return system(buf) >> 8;
  421.     }
  422. #else
  423.  
  424.  static int
  425. #ifdef KR_headers
  426.  compare(a,b)
  427.   char *a, *b;
  428. #else
  429.  compare(const void *a, const void *b)
  430. #endif
  431. { return strcmp(*(char **)a, *(char **)b); }
  432.  
  433. #ifdef KR_headers
  434. dsort(from, to)
  435.     char *from;
  436.     char *to;
  437. #else
  438. dsort(char *from, char *to)
  439. #endif
  440. {
  441.     struct Memb {
  442.         struct Memb *next;
  443.         int n;
  444.         char buf[32000];
  445.         };
  446.     typedef struct Memb memb;
  447.     memb *mb, *mb1;
  448.     register char *x, *x0, *xe;
  449.     register int c, n;
  450.     FILE *f;
  451.     char **z, **z0;
  452.     int nn = 0;
  453.  
  454.     f = opf(from, textread);
  455.     mb = (memb *)Alloc(sizeof(memb));
  456.     mb->next = 0;
  457.     x0 = x = mb->buf;
  458.     xe = x + sizeof(mb->buf);
  459.     n = 0;
  460.     for(;;) {
  461.         c = getc(f);
  462.         if (x >= xe && (c != EOF || x != x0)) {
  463.             if (!n)
  464.                 return 126;
  465.             nn += n;
  466.             mb->n = n;
  467.             mb1 = (memb *)Alloc(sizeof(memb));
  468.             mb1->next = mb;
  469.             mb = mb1;
  470.             memcpy(mb->buf, x0, n = x-x0);
  471.             x0 = mb->buf;
  472.             x = x0 + n;
  473.             xe = x0 + sizeof(mb->buf);
  474.             n = 0;
  475.             }
  476.         if (c == EOF)
  477.             break;
  478.         if (c == '\n') {
  479.             ++n;
  480.             *x++ = 0;
  481.             x0 = x;
  482.             }
  483.         else
  484.             *x++ = c;
  485.         }
  486.     clf(&f, from, 1);
  487.     f = opf(to, textwrite);
  488.     if (x > x0) { /* shouldn't happen */
  489.         *x = 0;
  490.         ++n;
  491.         }
  492.     mb->n = n;
  493.     nn += n;
  494.     if (!nn) /* shouldn't happen */
  495.         goto done;
  496.     z = z0 = (char **)Alloc(nn*sizeof(char *));
  497.     for(mb1 = mb; mb1; mb1 = mb1->next) {
  498.         x = mb1->buf;
  499.         n = mb1->n;
  500.         for(;;) {
  501.             *z++ = x;
  502.             if (--n <= 0)
  503.                 break;
  504.             while(*x++);
  505.             }
  506.         }
  507.     qsort((char *)z0, nn, sizeof(char *), compare);
  508.     for(n = nn, z = z0; n > 0; n--)
  509.         fprintf(f, "%s\n", *z++);
  510.     free((char *)z0);
  511.  done:
  512.     clf(&f, to, 1);
  513.     do {
  514.         mb1 = mb->next;
  515.         free((char *)mb);
  516.         }
  517.         while(mb = mb1);
  518.     return 0;
  519.     }
  520. #endif
  521.